home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / xaw / scrollbox < prev    next >
Encoding:
Text File  |  1991-09-26  |  1.1 KB  |  34 lines
  1. ;;; -*-Scheme-*-
  2. ;;;
  3. ;;; Scroll box demo
  4.  
  5. (require 'xwidgets)
  6. (load-widgets shell command box label)
  7.  
  8. (define items (list 'Helvetica 'Courier 'Times 'Palatino 'Zapf\ Chancery
  9.             'Zapf\ Dingbats))
  10. (set-cdr! (last-pair items) items)
  11.  
  12. (define top (application-initialize 'scrollbox))
  13. (define dpy (widget-display top))
  14.  
  15. (define dia-bits "\0\0\100\0\340\0\360\1\370\3\374\7\376\17\374\7\370\3\360\1\340\0\100\0\0\0")
  16. (define dia (create-bitmap-from-data (display-root-window dpy) dia-bits 13 13))
  17.  
  18. (define box (create-managed-widget (find-class 'box) top))
  19. (set-values! box 'width 200)
  20.  
  21. (define button (create-managed-widget (find-class 'command) box))
  22. (set-values! button 'bitmap dia)
  23.  
  24. (define label (create-managed-widget (find-class 'label) box))
  25. (set-values! label 'width 130 'label (car items) 'resize #f 'justify 'left
  26.                    'font (open-font dpy "*courier-bold-r-normal--14*"))
  27. (add-callback button 'callback
  28.   (lambda (w)
  29.     (set! items (cdr items))
  30.     (set-values! label 'label (car items))))
  31.  
  32. (realize-widget top)
  33. (context-main-loop (widget-context top))
  34.